Preditor de Cliques em Anúncios


Neste projeto será feito uma análise exploratória de um conjunto de dados de uma empresa de publicidade, que contém o histórico de acesso dos clientes ao site, com o intuito de saber se um cliente clicou ou não em um anúncio do site. Será criado um modelo que prevê se o cliente clicará ou não em um anúncio, baseado nos dados e histórico dos registros anteriores.


Importação dos pacotes necessários e do dataset.

library(tidyverse)
library(car)
library(psych)
library(DescTools)
library(plotly)
library(lubridate)

df <- read_csv("advertising.csv")

Visão Geral do dataset importado, e informações adicionais

df %>% head(3) %>% knitr::kable(align = "llllllll")
Daily Time Spent on Site Age Area Income City Male Country Timestamp Clicked on Ad
68.95 35 61833.90 Wrightburgh 0 Tunisia 2016-03-27 00:53:11 0
80.23 31 68441.85 West Jodi 1 Nauru 2016-04-04 01:39:02 0
69.47 26 59785.94 Davidton 0 San Marino 2016-03-13 20:35:42 0
df %>% str
## spec_tbl_df [1,000 × 8] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ Daily Time Spent on Site: num [1:1000] 69 80.2 69.5 74.2 68.4 ...
##  $ Age                     : num [1:1000] 35 31 26 29 35 23 33 48 30 20 ...
##  $ Area Income             : num [1:1000] 61834 68442 59786 54806 73890 ...
##  $ City                    : chr [1:1000] "Wrightburgh" "West Jodi" "Davidton" "West Terrifurt" ...
##  $ Male                    : num [1:1000] 0 1 0 1 0 1 0 1 1 1 ...
##  $ Country                 : chr [1:1000] "Tunisia" "Nauru" "San Marino" "Italy" ...
##  $ Timestamp               : POSIXct[1:1000], format: "2016-03-27 00:53:11" "2016-04-04 01:39:02" ...
##  $ Clicked on Ad           : num [1:1000] 0 0 0 0 0 0 0 1 0 0 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   `Daily Time Spent on Site` = col_double(),
##   ..   Age = col_double(),
##   ..   `Area Income` = col_double(),
##   ..   City = col_character(),
##   ..   Male = col_double(),
##   ..   Country = col_character(),
##   ..   Timestamp = col_datetime(format = ""),
##   ..   `Clicked on Ad` = col_double()
##   .. )

Renomeando e alterando os tipos das variáveis

colnames(df) <- c('minutos diarios no site', 'idade', 'renda anual', 'cidade do cliente', 'sexo', 'nacionalidade',
       'horario que saiu do site', 'clicou no anuncio')

df$sexo <- as_factor(df$sexo) %>% lvls_revalue(c("feminino","masculino")) %>% relevel(ref = "masculino")
df$`horario que saiu do site` <- as.character(df$`horario que saiu do site`) %>% ymd_hms()
df$`clicou no anuncio` <- as_factor(df$`clicou no anuncio`) %>% lvls_revalue(c("nao","sim"))

df %>% head(3) %>% knitr::kable(align = "llllllll")
minutos diarios no site idade renda anual cidade do cliente sexo nacionalidade horario que saiu do site clicou no anuncio
68.95 35 61833.90 Wrightburgh feminino Tunisia 2016-03-27 00:53:11 nao
80.23 31 68441.85 West Jodi masculino Nauru 2016-04-04 01:39:02 nao
69.47 26 59785.94 Davidton feminino San Marino 2016-03-13 20:35:42 nao

Verificando correlação entre as variáveis

Com isso, podemos ter uma ideia das variáveis mais importantes para análise e para o modelo preditivo.

pairs.panels(df[,c(8,1,2,3,5,7)])

OBS: É possivel notar que há 75% de correlação entre clicou no anuncio e minutos no site

Há 49% de correlação entre clicou no anuncio e idade.

48% de correlação entre clicou no anuncio e renda anual.

Também é possivel notar que sexo e horário em que saiu do site tem pouquíssima correlação não so com clicou no anuncio mas também com todas as outras variáveis.


Visualizando a distribuição de idade dos clientes

plot_ly(data = df, x=~idade, type = "histogram")

OBS: A maioria dos clientes estão na faixa dos 28 aos 40 anos


Visualizando quem clicou baseado na renda dos clientes e na idade

plot_ly( data = df, x=~`renda anual`, y=~idade, type = "scatter", color = ~`clicou no anuncio`, colors="Set1" )

OBS: É nítido que quanto maior a renda do cliente, menos interesse em anúncios, também é possível notar que as pessoas mais velhas e com uma renda menor, são as que mais clicam em anúncios.


Visualizando quantidade de tempo em minutos diários que os clientes navegam pelo site.

plot_ly(data=df, x=~`minutos diarios no site`, y=~idade, type = "scatter", color = ~`clicou no anuncio`, colors = c("darkmagenta","forestgreen"))

OBS: Curiosamente as pessoas que mais passam tempo navegando pelo site, são as que menos clicam nos anúncios


Confirmando ausência de correlação significativa da variável sexo

Verificando média de minutos que o cliente passa no site por sexo

df %>% group_by(sexo) %>% summarise("minutos diarios"=mean(`minutos diarios no site`), "idade"=mean(idade)) %>% knitr::kable(align = "lll", digits = 2)
sexo minutos diarios idade
masculino 64.69 35.82
feminino 65.29 36.19

OBS: Como esperado, não há tendência relevante, o sexo n tem significância em quem passa mais tempo no site, e nem na idade dos clientes


Gráfico representativo

plot_ly(data=df, x=~`minutos diarios no site`, y=~idade, type = "scatter", color = ~sexo, colors = c("mediumvioletred","forestgreen"))

OBS: Dados espalhados sem nenhum padrão, o que confirma que a variável sexo não tem significância para o modelo preditivo.


Criando modelo

O conjunto será particionado em dois, uma parte com 80% dos dados para treinar o modelo, e outra com 20% para testar o desempenho.

Como foi confirmado no gráfico de correlação que as únicas variáveis preditoras significantes para o modelo são minutos diarios no site, renda anual e idade , será criado modelos com estas variáveis.

Modelo 1: minutos diarios no site, renda anual e idade.

Modelo 2: minutos diarios no site e renda anual.

Modelo 3: apenas com minutos diarios no site.

indexTreino <- sample( 1:nrow(df), round(nrow(df) * 0.8)  )
dfTreino <- df[indexTreino,] %>% select(`minutos diarios no site`, `renda anual`, `idade`,  `clicou no anuncio`)
dfTeste <- df[-indexTreino,] %>% select(`minutos diarios no site`, `renda anual`, `idade`,  `clicou no anuncio`)


modelo1 <- glm(data = dfTreino, family = binomial(), formula = `clicou no anuncio` ~  `minutos diarios no site` + `renda anual` + idade)
modelo2 <- glm(data = dfTreino, family = binomial(), formula = `clicou no anuncio` ~  `minutos diarios no site` + `renda anual`)
modelo3 <- glm(data = dfTreino, family = binomial(), formula = `clicou no anuncio` ~  `minutos diarios no site`)

Verificando desepenho dos modelos

Será utilizado a métrica AIC e BIC para comparar desempenho dos 3 modelos, quanto menor o valor retornado por essas métricas, melhor o modelo.

list( AIC(modelo1, modelo2, modelo3), BIC(modelo1, modelo2, modelo3) ) %>% knitr::kable(align = "ll")
df AIC
modelo1 4 318.1902
modelo2 3 415.2855
modelo3 2 523.9196
df BIC
modelo1 4 336.9286
modelo2 3 429.3394
modelo3 2 533.2888

OBS: Em ambas as métricas o modelo1 teve o melhor resultado.


Analisando coeficientes do melhor modelo

coef(modelo1)
##               (Intercept) `minutos diarios no site`             `renda anual` 
##              15.470611542              -0.208569650              -0.000121322 
##                     idade 
##               0.163886172

OBS: minutos diarios no site e renda anual influenciam negativamente em quem clica no anuncio, ou seja, quanto maior a renda ou o tempo que o cliente navega no site, maior a chance dele NÃO clicar nos anúncios, já a idade influencia de forma positiva, portanto, quanto mais velho o indivíduo, maior as chances do mesmo clicar em anúncios.


Verificando o quanto as variaveis preditoras explicam os resultados dos cliques

Será utilizada a métrica do pseudo R quadrado, que dá a porcentagem do quanto as variáveis preditoras escolhidas explicam a variável a ser predita.

PseudoR2(modelo1, which = "Nagelkerke")
## Nagelkerke 
##  0.8421176

OBS: As variáveis escolhidas explicam aproximadamente 80% dos resultados dos cliques em anúncios.


Verificando Outliers

Será verificado os valores dos resíduos padronizados, para identificar outliers, o resultado dos resíduos padronizados devem ser maiores que 2, ou menores que -2

dfTreino$N <- 1:nrow(dfTreino)
dfTreino$residuo_padronizado <- rstandard(modelo1)

plot_ly(data = dfTreino, x=~N, y=~residuo_padronizado, marker=list(color="darkgreen"))

OBS: Podemos ver que alguns indivíduos são possíveis outliers


Verificando Pontos influentes

Antes de removermos os outliers, será verificado se estes influenciam de forma positiva no modelo, que seriam pontos influentes, para identificar estes individuos, será utilizado a métrica Distância de Cook.

É considerado um ponto influente, indivíduos com o valor da distância de cook próximo, igual ou maior que 1.

dfTreino$DistanciaCook <- cooks.distance(modelo1)
plot_ly(dfTreino, y=~DistanciaCook, x=~N, type = "scatter", marker=list(color="darkmagenta"))

OBS: Apesar de alguns indivíduos conterem o valor da distância de cook maior que o restante, não é o bastante para ser considerado um ponto influente


Removendo Outliers do dataset

será removido todo individuo que contenha residuos padronizados com valores maiores que 2 e menores que -2.

outliers <- filter(dfTreino, residuo_padronizado >= 2 | residuo_padronizado <= -2)$N
dfSemOutlier <- dfTreino[-outliers,]

Conferindo alteração

Resíduos padronizados sem outliers

plot_ly(data = dfSemOutlier, x=~N, y=~residuo_padronizado, marker=list(color="darkgreen"))

OBS: Agora com todos os resíduos padronizados menores que 2, e maiores que -2


Resíduos padronizados com outliers

plot_ly(data = dfTreino, x=~N, y=~residuo_padronizado, marker=list(color="darkgreen"))

Gerando o novo modelo sem os Outliers

modeloFinal <- glm(data = dfSemOutlier, family = binomial(), formula = `clicou no anuncio` ~  `minutos diarios no site` + `renda anual` + idade)

Comparando o novo modelo com o modelo 1

list( AIC(modeloFinal, modelo1), BIC(modeloFinal, modelo1) ) %>% knitr::kable()
df AIC
modeloFinal 4 200.0597
modelo1 4 318.1902
df BIC
modeloFinal 4 218.7072
modelo1 4 336.9286

OBS: Como podemos ver, o modelo final teve um resultado superior

Verificando o quanto as variáveis explicam os dados

Novamente será utilizada a métrica do pseudo R quadrado, so que comparando o modelo final com o modelo 1

Modelo final

modeloFinal %>%  PseudoR2(which = "Nagelkerke")
## Nagelkerke 
##  0.9071964

OBS: É notavel que agora sem outliers, aproximadamente 90% dos dados são explicados pelas variáveis, invés dos 80% do modelo com outliers


Modelo 1

modelo1 %>%  PseudoR2(which = "Nagelkerke")
## Nagelkerke 
##  0.8421176

Testando o modelo

Antes do teste, será feito o teste de multicolinearidade.

Multicolinearidade é quando há uma correlação muito forte entre variáveis preditoras, o que pode ser prejudicial na eficácia do modelo, é considerado caso de multicolinearidade quando a correlação entre as variáveis preditoras ultrapassam dos 0.8(80%).

pairs.panels(dfTreino %>% select(`renda anual`, `minutos diarios no site`, idade))

OBS: Como podemos ver, não há multicolinearidade entre as variáveis preditoras


Resultado das predições

Será aplicado a partição que representa 20% do dataset, para avaliar como que o modelo reage com dados que ele nunca viu.

Será gerado um gráfico de dispersão, que irá comparar os dados reais do conjunto de testes com as predições do modelo, ou seja, irá comparar o que realmente aconteceu, com o que o modelo preveu, colorindo de tom esverdeado os dados reais do conjunto teste que são individuos que CLICARAM em anúncios, e colorindo de tom avermelhado os dados reais do conjunto de teste que NÃO CLICARAM nos anúncios.

A numeração entre 0 a 100, equivale a porcentagem de chance de um indivíduo clicar nos anúncios, esta numeração nada mais é que o resultado da predição do modelo final.

Então, basicamente, quanto mais dados esverdeados(clicaram) no topo da porcentagem, e quanto mais dados avermelhados(não clicaram) no fundo, melhor desempenho de acerto o modelo tem na prática.

Gráfico representativo

preds <- predict( modeloFinal, select(dfTeste, -`clicou no anuncio`), type = "response" )

predicoes <- tibble( "Clicou no anuncio"=dfTeste$`clicou no anuncio`, "Predicao"=round(preds*100,2) )

plot_ly(data = predicoes, y=~Predicao, color=~`Clicou no anuncio`, type = "scatter", colors = c("firebrick","olivedrab"))

OBS: Podemos ver que a grande maioria dos individuos dos dados reais que clicaram(verdes), o modelo sugeriu uma % alta para chance do clique, e também sugeriu uma % baixa para a grande maioria dos individuos que realmente não clicaram(vermelhos) em anúncios.


Dataset da % de predições

predicoes$Predicao <- str_c(predicoes$Predicao,"%")
predicoes %>% head %>% knitr::kable(align = "ll")
Clicou no anuncio Predicao
sim 100%
sim 100%
sim 99.98%
nao 0.58%
nao 0.38%
sim 99.96%